SNA Descritive Analysis from “Projeto Redes de Atenção às pessoas que consomem álcool e outras Drogas em Juiz de Fora-MG Brazil” - SNArRDJF
Here you can find a basic script to analysis data from SNArRDJF - this script was elaborated considering its use for orther matrix adjacency data from SNArRDJF - Here we are going to analyse:
########################## Basic Preparation ##### `#########################
rm(list = ls()) # removing previous objects to be sure that we don't have objects conflicts name
load("~/SNArRDJF/Robject/acesso_positivo_data.RData")
suppressMessages(library(RColorBrewer))
#suppressMessages(library(car))
#suppressMessages(library(xtable))
suppressMessages(library(igraph))
#suppressMessages(library(miniCRAN))
#suppressMessages(library(magrittr))
#suppressMessages(library(keyplayer))
#suppressMessages(library(dplyr))
#suppressMessages(library(feather))
#suppressMessages(library(visNetwork))
#suppressMessages(library(knitr))
suppressMessages(library(DT))
#In order to get dinamic javascript object install those ones. If you get problems installing go to Stackoverflow.com and type your error to discover what to do. In some cases the libraries need to be intalled in outside R libs.
#devtools::install_github("wch/webshot")
#webshot::install_phantomjs()
set.seed(123)
#acesso_positivo<-simplify(acesso_positivo) #Simplify
• For undirected graphs:
– Actor centrality - involvement (connections) with other actors
• For directed graphs:
– Actor centrality - source of the ties (outgoing edges)
– Actor prestige - recipient of many ties (incoming edges)
In general - high centrality degree means direct contact with many other actors
V(acesso_positivo)$indegree<-degree(acesso_positivo, mode = "in") # Actor prestige - recipient of many ties (incoming edges)
V(acesso_positivo)$outdegree <- degree(acesso_positivo, mode = "out") # Actor centrality - source of the ties (outgoing edges)
V(acesso_positivo)$totaldegree <- degree(acesso_positivo, mode = "total")
acesso_positivo_indegree<-degree(acesso_positivo, mode = "in")
acesso_positivo_outdegree<-degree(acesso_positivo, mode = "out")
acesso_positivo_totaldegree<-degree(acesso_positivo, mode = "total")
##in
summary(acesso_positivo_indegree)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 3.500 5.000 8.364 9.000 106.000
sd(acesso_positivo_indegree)
## [1] 10.83237
hist(degree(acesso_positivo, mode = "in", normalized = F), ylab="Frequency", xlab="Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Indegree Nodes - 29_ACESSO_POSITIVO")
##out
summary(acesso_positivo_outdegree)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 1.000 4.000 8.364 8.000 105.000
sd(acesso_positivo_outdegree)
## [1] 13.97334
hist(degree(acesso_positivo, mode = "out", normalized = F), ylab="Frequency", xlab="Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Outdegree Nodes - 29_ACESSO_POSITIVO")
##all
summary(acesso_positivo_totaldegree)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 5.00 10.00 16.73 18.00 211.00
sd(acesso_positivo_totaldegree)
## [1] 23.44349
hist(degree(acesso_positivo, mode = "all", normalized = F), ylab="Frequency", xlab="Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of All Degree Nodes - 29_ACESSO_POSITIVO")
A slightly more nuanced metric is “strength centrality”, which is defined as the sum of the weights of all the connections for a given node. This is also sometimes called “weighted degree centrality”
V(acesso_positivo)$acesso_positivo_strength<- strength(acesso_positivo, weights=E(acesso_positivo)$weight)
acesso_positivo_strength<- strength(acesso_positivo, weights=E(acesso_positivo)$weight)
summary(acesso_positivo_strength)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 29.0 51.0 99.1 97.0 1421.0
sd(acesso_positivo_strength)
## [1] 144.4332
hist(strength(acesso_positivo, weights=E(acesso_positivo)$weight), ylab="Frequency", xlab="Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Strength Degree Nodes - 29_ACESSO_POSITIVO")
V(acesso_positivo)$indegree_n<-degree(acesso_positivo, mode = "in", normalized = T)
V(acesso_positivo)$outdegree_n<- degree(acesso_positivo, mode = "out", normalized = T)
V(acesso_positivo)$totaldegree_n<- degree(acesso_positivo, mode = "total", normalized = T)
acesso_positivo_indegree_n<-degree(acesso_positivo, mode = "in", normalized = T)
acesso_positivo_outdegree_n<-degree(acesso_positivo, mode = "out", normalized = T)
acesso_positivo_totaldegree_n<-degree(acesso_positivo, mode = "total", normalized = T)
summary(acesso_positivo_indegree_n)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00000 0.01882 0.02688 0.04497 0.04839 0.56990
sd(acesso_positivo_indegree_n)
## [1] 0.05823853
hist(degree(acesso_positivo, mode = "in", normalized = T), ylab="Frequency", xlab="Normalized Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Normalized Indegree Nodes - 29_ACESSO_POSITIVO")
summary(acesso_positivo_outdegree_n)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000000 0.005376 0.021510 0.044970 0.043010 0.564500
sd(acesso_positivo_outdegree_n)
## [1] 0.07512547
hist(degree(acesso_positivo, mode = "out", normalized = T), ylab="Frequency", xlab="Normalized Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Normalized Outdegree Nodes - 29_ACESSO_POSITIVO")
summary(acesso_positivo_totaldegree_n)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.005376 0.026880 0.053760 0.089930 0.096770 1.134000
sd(acesso_positivo_totaldegree_n)
## [1] 0.1260403
hist(degree(acesso_positivo, mode = "all", normalized = T), ylab="Frequency", xlab="Normalized Degree", breaks=vcount(acesso_positivo)/10, main="Histogram of Normalized All Degree Nodes - 29_ACESSO_POSITIVO")
V(acesso_positivo)$acesso_positivo_centr_degree <- centralization.degree(acesso_positivo)$res
acesso_positivo_centr_degree <- centralization.degree(acesso_positivo)
acesso_positivo_centr_degree$centralization
## [1] 0.5250462
acesso_positivo_centr_degree$theoretical_max
## [1] 69192
acesso_positivo_degree.distribution<-degree.distribution(acesso_positivo)
summary(acesso_positivo_degree.distribution)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000000 0.000000 0.000000 0.004717 0.000000 0.096260
sd(acesso_positivo_degree.distribution)
## [1] 0.01452209
hist(degree.distribution(acesso_positivo), breaks=vcount(acesso_positivo)/10, ylab="Frequency", xlab="Degree Distribuition", main="Histogram of Degree Distribuition - 29_ACESSO_POSITIVO")
dd <- degree.distribution(acesso_positivo, cumulative=T, mode="all")
plot(dd, pch=19, cex=1, col="orange", xlab="Degree", ylab="Cumulative Frequency", main= "Cumulative Frequency of 29_ACESSO_POSITIVO ")
dd.acesso_positivo <- degree.distribution(acesso_positivo)
d <- 1:max(degree(acesso_positivo))-1
ind <- (dd.acesso_positivo != 0)
plot(d[ind],
dd.acesso_positivo[ind],
log="xy",
col="blue",
xlab=c("Log-Degree"),
ylab=c("Log-Intensity"),
main="Log-Log Degree Distribution For 29_ACESSO_POSITIVO"
)
The neighborhood of a given order y of a vertex v includes all vertices which are closer to v than the order. Ie. order y=0 is always v itself, order 1 is v plus its immediate neighbors, order 2 is order 1 plus the immediate neighbors of the vertices in order 1, etc.
acesso_positivo_simplified<-simplify(acesso_positivo)
acesso_positivo_a.nn.deg <- graph.knn(acesso_positivo_simplified, weights =E(acesso_positivo_simplified)$weight)$knn %>% round(1)
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg <- graph.knn(acesso_positivo_simplified, weights=E(acesso_positivo_simplified)$weight)$knn
d<-cbind(V(acesso_positivo_simplified)$LABEL_COR,acesso_positivo_a.nn.deg)
datatable(d)
plot(degree(acesso_positivo_simplified),
acesso_positivo_a.nn.deg,
log="xy",
col="goldenrod",
xlab=c("Log Vertex Degree"),
ylab=c("Log Average Neighbor Degree"),
main="Average Neighbor Degree vs Vertex Degree - Log-Log Scale for 29_ACESSO_POSITIVO"
)
acesso_positivo_a.nn.deg_w <- graph.knn(acesso_positivo_simplified, weights=E(acesso_positivo_simplified)$weight)$knn %>% round(1)
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w <-acesso_positivo_a.nn.deg <- graph.knn(acesso_positivo_simplified, weights=E(acesso_positivo_simplified)$weight)$knn
summary(acesso_positivo_a.nn.deg_w)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 2.30 35.40 50.70 71.37 103.80 380.10 1
sd(acesso_positivo_a.nn.deg_w, na.rm = T)
## [1] 52.59071
d<-cbind(V(acesso_positivo_simplified)$LABEL_COR,acesso_positivo_a.nn.deg_w)
datatable(d)
plot(degree(acesso_positivo_simplified),
acesso_positivo_a.nn.deg,
log="xy",
col="goldenrod",
xlab=c("Log Vertex Degree"),
ylab=c("Log Average Neighbor Degree"),
main="Average Weighted Neighbor Degree vs Vertex Degree - Log-Log Scale For Weighted 29_ACESSO_POSITIVO"
)
acesso_positivo_indegree<-degree(acesso_positivo, mode = "in")
acesso_positivo_outdegree<-degree(acesso_positivo, mode = "out")
acesso_positivo_totaldegree<-degree(acesso_positivo, mode = "total")
acesso_positivo_strength<- strength(acesso_positivo, weights=E(acesso_positivo)$weight)
acesso_positivo_indegree_n<-degree(acesso_positivo, mode = "in", normalized = T) %>% round(3)
acesso_positivo_outdegree_n<-degree(acesso_positivo, mode = "out", normalized = T) %>% round(3)
acesso_positivo_totaldegree_n<-degree(acesso_positivo, mode = "total", normalized = T) %>% round(3)
acesso_positivo_centr_degree <- centralization.degree(acesso_positivo)$res
acesso_positivo_a.nn.deg <- graph.knn(acesso_positivo_simplified)$knn %>% round(1)
acesso_positivo_a.nn.deg_w <- graph.knn(acesso_positivo_simplified, weights=E(acesso_positivo_simplified)$weight)$knn %>% round(1)
acesso_positivo_df_degree <- data.frame(acesso_positivo_indegree,
acesso_positivo_outdegree,
acesso_positivo_totaldegree,
acesso_positivo_indegree_n,
acesso_positivo_outdegree_n,
acesso_positivo_totaldegree_n,
acesso_positivo_strength,
acesso_positivo_centr_degree,
acesso_positivo_a.nn.deg,
acesso_positivo_a.nn.deg_w) %>% round(3)
#Adding type
acesso_positivo_df_degree <-cbind(acesso_positivo_df_degree, V(acesso_positivo)$LABEL_COR)
#Adding names
names(acesso_positivo_df_degree) <- c("In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree","Type")
#Ordering Variables
acesso_positivo_df_degree<-acesso_positivo_df_degree[c("Type","In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree")]
datatable(acesso_positivo_df_degree, filter = 'top')
aggdata_mean <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=mean, na.rm=TRUE)
#Removing Type variable
aggdata_mean<-aggdata_mean[,-c(2)]
names(aggdata_mean) <- c("Group", "In Degree(M)", "Out Degree(M)", "Total Degree(M)","In Degree Normalized(M)", "Out Degree Normalized(M)", "Total Degree Normalized(M)", "Strength(M)","Centralization Degree(M)","Average Neighbor Degree(M)","Average Weighted Neighbor Degree(M)")
aggdata_sd <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=sd, na.rm=TRUE)
#Removing Type variable
aggdata_sd<-aggdata_sd[,-c(2)]
names(aggdata_sd) <- c("Group", "In Degree(SD)", "Out Degree(SD)", "Total Degree(SD)","In Degree Normalized(SD)", "Out Degree Normalized(SD)", "Total Degree Normalized(SD)", "Strength(SD)","Centralization Degree(SD)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(SD)")
total_table <- merge(aggdata_mean,aggdata_sd,by="Group")
#Rounding
Group<-total_table[,c(1)] #Keeping group
total_table<-total_table[,-c(1)] %>% round(2) #Rouding
total_table<-cbind(Group,total_table) #Binding toghter
#Organizing Variabels
total_table<-total_table[c("Group","In Degree(M)","In Degree(SD)", "Out Degree(M)", "Out Degree(SD)","Total Degree(M)", "Total Degree(SD)", "In Degree Normalized(M)", "In Degree Normalized(SD)", "Out Degree Normalized(M)", "Out Degree Normalized(SD)", "Total Degree Normalized(M)", "Total Degree Normalized(SD)", "Strength(M)","Strength(SD)", "Centralization Degree(M)","Centralization Degree(SD)","Average Neighbor Degree(M)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(M)", "Average Weighted Neighbor Degree(SD)")]
datatable(total_table, filter = 'top')
acesso_positivo_df_degree <- data.frame(acesso_positivo_indegree,
acesso_positivo_outdegree,
acesso_positivo_totaldegree,
acesso_positivo_indegree_n,
acesso_positivo_outdegree_n,
acesso_positivo_totaldegree_n,
acesso_positivo_strength,
acesso_positivo_centr_degree,
acesso_positivo_a.nn.deg,
acesso_positivo_a.nn.deg_w) %>% round(3)
#Adding type
acesso_positivo_df_degree <-cbind(acesso_positivo_df_degree, V(acesso_positivo)$TIPO1)
#Adding names
names(acesso_positivo_df_degree) <- c("In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree","Type")
#Ordering Variables
acesso_positivo_df_degree<-acesso_positivo_df_degree[c("Type","In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree")]
datatable(acesso_positivo_df_degree, filter = 'top')
aggdata_mean <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=mean, na.rm=TRUE)
#Removing Type variable
aggdata_mean<-aggdata_mean[,-c(2)]
names(aggdata_mean) <- c("Group", "In Degree(M)", "Out Degree(M)", "Total Degree(M)","In Degree Normalized(M)", "Out Degree Normalized(M)", "Total Degree Normalized(M)", "Strength(M)","Centralization Degree(M)","Average Neighbor Degree(M)","Average Weighted Neighbor Degree(M)")
aggdata_sd <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=sd, na.rm=TRUE)
#Removing Type variable
aggdata_sd<-aggdata_sd[,-c(2)]
names(aggdata_sd) <- c("Group", "In Degree(SD)", "Out Degree(SD)", "Total Degree(SD)","In Degree Normalized(SD)", "Out Degree Normalized(SD)", "Total Degree Normalized(SD)", "Strength(SD)","Centralization Degree(SD)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(SD)")
total_table <- merge(aggdata_mean,aggdata_sd,by="Group")
#Rounding
Group<-total_table[,c(1)] #Keeping group
total_table<-total_table[,-c(1)] %>% round(2) #Rouding
total_table<-cbind(Group,total_table) #Binding toghter
#Organizing Variabels
total_table<-total_table[c("Group","In Degree(M)","In Degree(SD)", "Out Degree(M)", "Out Degree(SD)","Total Degree(M)", "Total Degree(SD)", "In Degree Normalized(M)", "In Degree Normalized(SD)", "Out Degree Normalized(M)", "Out Degree Normalized(SD)", "Total Degree Normalized(M)", "Total Degree Normalized(SD)", "Strength(M)","Strength(SD)", "Centralization Degree(M)","Centralization Degree(SD)","Average Neighbor Degree(M)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(M)", "Average Weighted Neighbor Degree(SD)")]
datatable(total_table, filter = 'top')
acesso_positivo_df_degree <- data.frame(acesso_positivo_indegree,
acesso_positivo_outdegree,
acesso_positivo_totaldegree,
acesso_positivo_indegree_n,
acesso_positivo_outdegree_n,
acesso_positivo_totaldegree_n,
acesso_positivo_strength,
acesso_positivo_centr_degree,
acesso_positivo_a.nn.deg,
acesso_positivo_a.nn.deg_w) %>% round(3)
#Adding type
acesso_positivo_df_degree <-cbind(acesso_positivo_df_degree, V(acesso_positivo)$TIPO2)
#Adding names
names(acesso_positivo_df_degree) <- c("In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree","Type")
#Ordering Variables
acesso_positivo_df_degree<-acesso_positivo_df_degree[c("Type","In Degree", "Out Degree", "Total Degree","In Degree Normalized", "Out Degree Normalized", "Total Degree Normalized", "Strength","Centralization Degree","Average Neighbor Degree","Average Weighted Neighbor Degree")]
datatable(acesso_positivo_df_degree, filter = 'top')
aggdata_mean <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=mean, na.rm=TRUE)
#Removing Type variable
aggdata_mean<-aggdata_mean[,-c(2)]
names(aggdata_mean) <- c("Group", "In Degree(M)", "Out Degree(M)", "Total Degree(M)","In Degree Normalized(M)", "Out Degree Normalized(M)", "Total Degree Normalized(M)", "Strength(M)","Centralization Degree(M)","Average Neighbor Degree(M)","Average Weighted Neighbor Degree(M)")
aggdata_sd <-aggregate(acesso_positivo_df_degree, by=list(acesso_positivo_df_degree$Type), FUN=sd, na.rm=TRUE)
#Removing Type variable
aggdata_sd<-aggdata_sd[,-c(2)]
names(aggdata_sd) <- c("Group", "In Degree(SD)", "Out Degree(SD)", "Total Degree(SD)","In Degree Normalized(SD)", "Out Degree Normalized(SD)", "Total Degree Normalized(SD)", "Strength(SD)","Centralization Degree(SD)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(SD)")
total_table <- merge(aggdata_mean,aggdata_sd,by="Group")
#Rounding
Group<-total_table[,c(1)] #Keeping group
total_table<-total_table[,-c(1)] %>% round(2) #Rouding
total_table<-cbind(Group,total_table) #Binding toghter
#Organizing Variabels
total_table<-total_table[c("Group","In Degree(M)","In Degree(SD)", "Out Degree(M)", "Out Degree(SD)","Total Degree(M)", "Total Degree(SD)", "In Degree Normalized(M)", "In Degree Normalized(SD)", "Out Degree Normalized(M)", "Out Degree Normalized(SD)", "Total Degree Normalized(M)", "Total Degree Normalized(SD)", "Strength(M)","Strength(SD)", "Centralization Degree(M)","Centralization Degree(SD)","Average Neighbor Degree(M)","Average Neighbor Degree(SD)","Average Weighted Neighbor Degree(M)", "Average Weighted Neighbor Degree(SD)")]
datatable(total_table, filter = 'top')
#Set Seed
set.seed(123)
#Plotting based only on degree measures
edge.start <- ends(acesso_positivo, es=E(acesso_positivo), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(acesso_positivo))
maxC <- rep(Inf, vcount(acesso_positivo))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(acesso_positivo, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(acesso_positivo)$weight)
#PLotting
plot(acesso_positivo,
layout=co,
edge.color=V(acesso_positivo)$color[edge.start],
edge.arrow.size=(degree(acesso_positivo)+1)/(30*mean(degree(acesso_positivo))),
edge.width=E(acesso_positivo)$weight/(10*mean(E(acesso_positivo)$weight)),
edge.curved = TRUE,
vertex.size=log((degree(acesso_positivo)+2))*(0.5*mean(degree(acesso_positivo))),
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(acesso_positivo,"LABEL_COR"),
vertex.label.cex=log(degree(acesso_positivo)+2)/mean(degree(acesso_positivo)),
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(acesso_positivo)$LABEL_COR
b<-V(acesso_positivo)$color
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=2,
bty="n",
ncol=1,
lty=1,
cex = .5)
#Adding Title
title("Network Vertex Degree Sized - 29_ACESSO_POSITIVO", sub = "Source: from authors ", cex = .5)
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Median In Degree: %.2f\n Median Out Degree: %.2f",
median(degree(acesso_positivo, mode="in")),
median(degree(acesso_positivo, mode="out"))
))
#Set Seed
set.seed(123)
#Get Variable
V(acesso_positivo)$acesso_positivo_color_degree<-V(acesso_positivo)$totaldegree %>% round(0)
#Creating brewer pallette
vertex_acesso_positivo_color_degree<-
colorRampPalette(brewer.pal(length(unique(
V(acesso_positivo)$acesso_positivo_color_degree)), "RdBu"))(
length(unique(V(acesso_positivo)$acesso_positivo_color_degree)))
#Saving as Vertex properties
V(acesso_positivo)$vertex_acesso_positivo_color_degree<- vertex_acesso_positivo_color_degree[as.numeric(cut(degree(acesso_positivo),breaks =length(unique(V(acesso_positivo)$acesso_positivo_color_degree))))]
set.seed(123)
#Plotting based only on degree measures
edge.start <- ends(acesso_positivo, es=E(acesso_positivo), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(acesso_positivo))
maxC <- rep(Inf, vcount(acesso_positivo))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(acesso_positivo, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(acesso_positivo)$weight)
#PLotting
plot(acesso_positivo,
layout=co,
#edge.color=V(acesso_positivo)$color[edge.start],
edge.arrow.size=(degree(acesso_positivo)+1)/1000,
edge.width=E(acesso_positivo)$weight/10,
edge.curved = TRUE,
vertex.color=V(acesso_positivo)$vertex_acesso_positivo_color_degree,
vertex.size=log((degree(acesso_positivo)+2))*10,
vertex.size=20,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(acesso_positivo,"LABEL_COR"),
vertex.label.cex=log((degree(acesso_positivo)+2))/10,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(acesso_positivo)$acesso_positivo_color_degree
b<-V(acesso_positivo)$vertex_acesso_positivo_color_degree
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
e<-e[order(e$a,decreasing=T),]
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=2,
bty="n",
ncol=1,
lty=1,
cex = .3)
#Adding Title
title("Network Vertex Degree Sized and Red to Blue - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Median In Degree: %.2f\nMedian Out Degree: %.2f",
median(degree(acesso_positivo, mode="in")),
median(degree(acesso_positivo, mode="out"))
))
#Set Seed
set.seed(123)
#Get Variable
V(acesso_positivo)$acesso_positivo_color_degree<-V(acesso_positivo)$acesso_positivo_centr_degree
#Creating brewer pallette
vertex_acesso_positivo_color_degree<-
colorRampPalette(brewer.pal(length(unique(
V(acesso_positivo)$acesso_positivo_color_degree)), "Spectral"))(
length(unique(V(acesso_positivo)$acesso_positivo_color_degree)))
#Saving as Vertex properties
V(acesso_positivo)$vertex_acesso_positivo_color_degree<- vertex_acesso_positivo_color_degree[as.numeric(cut(V(acesso_positivo)$acesso_positivo_color_degree,breaks =length(unique(V(acesso_positivo)$acesso_positivo_color_degree))))]
#Plotting based only on degree measures
edge.start <- ends(acesso_positivo, es=E(acesso_positivo), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(acesso_positivo))
maxC <- rep(Inf, vcount(acesso_positivo))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(acesso_positivo, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(acesso_positivo)$weight)
#PLotting
plot(acesso_positivo,
layout=co,
edge.color=V(acesso_positivo)$vertex_acesso_positivo_color_degree[edge.start],
edge.arrow.size=(degree(acesso_positivo)+1)/10000,
edge.width=E(acesso_positivo)$weight/10,
edge.curved = TRUE,
vertex.color=V(acesso_positivo)$vertex_acesso_positivo_color_degree,
vertex.size=log((V(acesso_positivo)$acesso_positivo_centr_degree+2))*10,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(acesso_positivo,"LABEL_COR"),
vertex.label.cex=log((degree(acesso_positivo)+2))/10,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(acesso_positivo)$acesso_positivo_color_degree
b<-V(acesso_positivo)$vertex_acesso_positivo_color_degree
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
e<-e[order(e$a,decreasing=T),]
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=2,
bty="n",
ncol=1,
lty=1,
cex = .3)
#Adding Title
title("Network Vertex Centralization Degree Sized Spectral Colored - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Median In Degree: %.2f\nMedian Out Degree: %.2f",
median(degree(acesso_positivo, mode="in")),
median(degree(acesso_positivo, mode="out"))
))
#Set Seed
set.seed(123)
# Network elements with lower than meadian degree
higherthanmedian.network_acesso_positivo<-V(acesso_positivo)[degree(acesso_positivo)<median(degree(acesso_positivo))]
#Deleting vertices based in intersection betewenn acesso_positivo
high_acesso_positivo<-delete.vertices(acesso_positivo, higherthanmedian.network_acesso_positivo)
#Plotting based only on degree measures
edge.start <- ends(high_acesso_positivo, es=E(high_acesso_positivo), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(high_acesso_positivo))
maxC <- rep(Inf, vcount(high_acesso_positivo))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(high_acesso_positivo, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(high_acesso_positivo)$weight)
#PLotting
plot(high_acesso_positivo,
layout=co,
edge.color=V(high_acesso_positivo)$color[edge.start],
edge.arrow.size=(degree(high_acesso_positivo)+1)/1000,
edge.width=E(high_acesso_positivo)$weight/10,
edge.curved = TRUE,
vertex.size=log((V(high_acesso_positivo)$acesso_positivo_centr_degree+2))*10,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(high_acesso_positivo,"LABEL_COR"),
vertex.label.cex=log((degree(high_acesso_positivo)+2))/10,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(high_acesso_positivo)$LABEL_COR
b<-V(high_acesso_positivo)$color
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=3,
bty="n",
ncol=1,
lty=1,
cex = .5)
#Adding Title
title("Network Higher Than Median Degree - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Mean In Degree: %.2f\n Mean Out Degree: %.2f",
mean(degree(high_acesso_positivo, mode="in")),
mean(degree(high_acesso_positivo, mode="out"))
)
)
#Set Seed
set.seed(123)
# Network elements with lower than meadian degree
lowerthanmedian.network_acesso_positivo<-V(acesso_positivo)[degree(acesso_positivo)>median(degree(acesso_positivo))]
#Deleting vertices based in intersection betewenn acesso_positivo
small_acesso_positivo<-delete.vertices(acesso_positivo, lowerthanmedian.network_acesso_positivo)
#Plotting based only on degree measures
edge.start <- ends(small_acesso_positivo, es=E(small_acesso_positivo), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(small_acesso_positivo))
maxC <- rep(Inf, vcount(small_acesso_positivo))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(small_acesso_positivo, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(small_acesso_positivo)$weight)
#PLotting
plot(small_acesso_positivo,
layout=co,
edge.color=V(small_acesso_positivo)$color[edge.start],
edge.arrow.size=(degree(small_acesso_positivo)+1)/1000,
edge.width=E(small_acesso_positivo)$weight/10,
edge.curved = TRUE,
vertex.size=log((V(small_acesso_positivo)$acesso_positivo_centr_degree+2))*20,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(small_acesso_positivo,"LABEL_COR"),
vertex.label.cex=log((degree(small_acesso_positivo)+2))/3,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(small_acesso_positivo)$LABEL_COR
b<-V(small_acesso_positivo)$color
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=4,
bty="n",
ncol=1,
lty=1,
cex = .5)
#Adding Title
title("Network Smaller Than Median Degree - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Mean In Degree: %.2f\nMean Out Degree: %.2f",
mean(degree(small_acesso_positivo, mode="in")),
mean(degree(small_acesso_positivo, mode="out"))
)
)
#Set Seed
set.seed(123)
#Plotting based only on degree measures
edge.start <- ends(acesso_positivo_simplified, es=E(acesso_positivo_simplified), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(acesso_positivo_simplified))
maxC <- rep(Inf, vcount(acesso_positivo_simplified))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(acesso_positivo_simplified, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(acesso_positivo_simplified)$weight)
#Plotting based only on degree measures #acesso_positivo_simplified_a.nn.deg
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg<-as.numeric(graph.knn(acesso_positivo_simplified)$knn)
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg[V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg=="NaN"]<-0
#PLotting
plot(acesso_positivo_simplified,
layout=co,
edge.color=V(acesso_positivo_simplified)$color[edge.start],
edge.arrow.size=sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg)^2+1)/1000,
edge.width=E(acesso_positivo_simplified)$weight/100,
edge.curved = TRUE,
vertex.color=V(acesso_positivo_simplified)$color,
vertex.size=(sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg)^2))/5,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(acesso_positivo_simplified,"LABEL_COR"),
vertex.label.cex=(sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg)^2)+1)/500,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(acesso_positivo_simplified)$LABEL_COR
b<-V(acesso_positivo_simplified)$color
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=4,
bty="n",
ncol=1,
lty=1,
cex = .5)
#Adding Title
title("Network Average Neighbor Degree Sized - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Median Average Neighbor Degree: %.2f",
median((acesso_positivo_a.nn.deg+1))
))
#Set Seed
set.seed(123)
#Plotting based only on degree measures
edge.start <- ends(acesso_positivo_simplified, es=E(acesso_positivo_simplified), names=F)[,1]
# Fixing ego
minC <- rep(-Inf, vcount(acesso_positivo_simplified))
maxC <- rep(Inf, vcount(acesso_positivo_simplified))
minC[1] <- maxC[1] <- 0
co <- layout_with_fr(acesso_positivo_simplified, niter=10000, minx=minC, maxx=maxC,miny=minC, maxy=maxC, weights = E(acesso_positivo_simplified)$weight)
#Plotting based only on degree measures #acesso_positivo_a.nn.deg
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w<-as.numeric(graph.knn(acesso_positivo_simplified, weights = E(acesso_positivo_simplified)$weight)$knn)
V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w[V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w=="NaN"]<-0
#PLotting
plot(acesso_positivo_simplified,
layout=co,
edge.color=V(acesso_positivo_simplified)$color[edge.start],
edge.arrow.size=sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w)^2+1)/1000,
edge.width=E(acesso_positivo_simplified)$weight/100,
edge.curved = TRUE,
vertex.color=V(acesso_positivo_simplified)$color,
vertex.size=(sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w)^2))/5,
vertex.frame.color="#ffffff",
vertex.label.color="black",
vertex.label=get.vertex.attribute(acesso_positivo_simplified,"LABEL_COR"),
vertex.label.cex=(sqrt((V(acesso_positivo_simplified)$acesso_positivo_a.nn.deg_w)^2)+1)/500,
vertex.label.dist=0,
rescale=F,
xlim=range(co[,1]),
ylim=range(co[,2]))
axis(1)
axis(2)
#Solving Problems with legend rendering
a<-V(acesso_positivo_simplified)$LABEL_COR
b<-V(acesso_positivo_simplified)$color
c<-table(a,b)
d<-as.data.frame(c)
e<-subset(d, d$Freq>0)
f<-t(e$a)
g<-t(e$b)
#Adding Legend
legend(x=range(co[,1])[2], y=range(co[,2])[2],
legend=as.character(f),
pch=21,
col = "#777777",
pt.bg=as.character(g),
pt.cex=4,
bty="n",
ncol=1,
lty=1,
cex = .5)
#Adding Title
title("Network Average Weighted Neighbor Degree Sized - 29_ACESSO_POSITIVO", sub = "Source: from authors ")
text(x=range(co[,1])[1], y=range(co[,2])[1], labels =
sprintf("Median Average Weighted Neighbor Degree: %.2f",
median((acesso_positivo_a.nn.deg_w+1))
))
#Circle Degree ***Too intense computation***
#A_acesso_positivo <- get.adjacency(acesso_positivo, sparse=FALSE)
#detach("package:igraph", unload=TRUE)
#library(network)
#g <- network::as.network.matrix(A_acesso_positivo)
#library(sna)
#gplot.target(g, degree(g), main="Circle Degree")
#library(igraph)
save.image("~/SNArRDJF/Robject/acesso_positivo_data.RData")